home *** CD-ROM | disk | FTP | other *** search
/ CU Amiga Super CD-ROM 2 / CU Amiga Magazine's Super CD-ROM 02 (1996)(EMAP Images)(GB)[!][issue 1996-04].iso / magazine / amiga_e / divers / mappic.e < prev    next >
Text File  |  1994-05-02  |  7KB  |  156 lines
  1. /*********************************/
  2. /* MAppIc v0.0b (c) 1993 NasGûl  */
  3. /*********************************/
  4.  
  5. OPT OSVERSION=37
  6. OPT LARGE
  7. ENUM ER_NONE,ER_BADARGS,ER_MEM,ER_UTILLIB,ER_ICONLIB,ER_WBLIB,ER_APPIC,
  8.      ER_INTUILIB,ER_EXECLIB,ER_SIG,ER_REQTOOLSLIB
  9.  
  10. ENUM ARG_ICON,ARG_COM,ARG_NAME,ARG_QUIT,ARG_TEST,ARG_MULTI,NUMARGS
  11.  
  12.  
  13. MODULE 'dos/dosasl','dos/dos','utility','utility/tagitem'
  14. MODULE 'whatis','icon','wb','workbench/workbench','workbench/startup',
  15.        'intuition/intuition','exec/ports','exec/nodes','exec/tasks'
  16. MODULE 'reqtools','libraries/reqtools'
  17.  
  18. RAISE ER_MEM IF New()=NIL,
  19.       ER_MEM IF String()=NIL,
  20.       ERROR_BREAK IF CtrlC()=TRUE
  21.  
  22.  
  23. DEF com,rdargs=NIL,commande[50]:STRING,name[20]:STRING
  24. DEF appmsg:PTR TO appmessage
  25. DEF sig,myport,appicon,res:PTR TO mp,quit=1,de_passage
  26. DEF struc_diskobj:PTR TO diskobject,ic_test,multi,f_lock,base_lock
  27. PROC main() HANDLE /*"Main()"*/
  28.   DEF args[NUMARGS]:LIST,templ,x,wb_args:PTR TO wbarg
  29.   DEF ver[50]:STRING,icone[200]:STRING,final_com[256]:STRING
  30.   DEF task:PTR TO tc,noeud:PTR TO ln,fib:PTR TO fileinfoblock
  31.   /*******************************************************************/
  32.   VOID '$VER:MAppIc v0.0b (c) NasGûl (04-11-93)'
  33.   IF (sig:=AllocSignal(-1))=NIL THEN Raise(ER_SIG)
  34.   task:=FindTask(0)
  35.   noeud:=task.ln
  36.   IF base_lock:=Lock(noeud.name,fib) THEN UnLock(base_lock)
  37.   IF (utilitybase:=OpenLibrary('utility.library',37))=NIL THEN Raise(ER_UTILLIB)
  38.   IF (iconbase:=OpenLibrary('icon.library',37))=NIL THEN Raise(ER_ICONLIB)
  39.   IF (workbenchbase:=OpenLibrary('workbench.library',37))=NIL THEN Raise(ER_WBLIB)
  40.   IF (intuitionbase:=OpenLibrary('intuition.library',37))=NIL THEN Raise(ER_INTUILIB)
  41.   IF (reqtoolsbase:=OpenLibrary('reqtools.library',37))=NIL THEN Raise(ER_REQTOOLSLIB)
  42.   FOR x:=0 TO NUMARGS-1 DO args[x]:=0
  43.   templ:='ICON/A,COM/K,NAME/K,QUIT/S,TEST/S,MULTI/S'
  44.   rdargs:=ReadArgs(templ,args,NIL)
  45.   IF rdargs=NIL THEN Raise(ER_BADARGS)
  46.   StrCopy(icone,args[ARG_ICON],ALL)
  47.   StrCopy(commande,args[ARG_COM],ALL)
  48.   IF args[ARG_NAME] THEN StrCopy(name,args[ARG_NAME],ALL) ELSE StrCopy(name,'        ',ALL)
  49.   de_passage:=args[ARG_QUIT]
  50.   ic_test:=args[ARG_TEST]
  51.   multi:=args[ARG_MULTI]
  52.   IF de_passage=-1 AND multi=-1 THEN Raise(ER_BADARGS)
  53.   IF struc_diskobj:=GetDiskObject(icone)
  54.       IF ic_test=-1
  55.           WriteF('Position En X :\d\n',struc_diskobj.currentx)
  56.           WriteF('Position En Y :\d\n',struc_diskobj.currenty)
  57.           Raise(ER_NONE)
  58.       ENDIF
  59.       WriteF('\h\n',struc_diskobj)
  60.       struc_diskobj.currentx:=Val(FindToolType(struc_diskobj.tooltypes,'POSX'),NIL)
  61.       struc_diskobj.currenty:=Val(FindToolType(struc_diskobj.tooltypes,'POSY'),NIL)
  62.       IF myport:=CreateMsgPort()
  63.           IF (appicon:=AddAppIconA(0,0,name,myport,NIL,struc_diskobj,
  64.                                   [MTYPE_APPICON,TAG_DONE]))=NIL THEN Raise(ER_APPIC)
  65.           REPEAT
  66.               res:=WaitPort(myport)
  67.               IF multi=-1 THEN quit:=RtEZRequestA('(c) 1993 By NasGûl','_Lancer|_Cancel|_Quit',0,0,[RTEZ_REQTITLE,
  68.                                                                        'MAppIc v0.0b',RT_UNDERSCORE,"_", TAG_DONE]:tagitem)
  69.               IF appmsg:=GetMsg(myport)
  70.                   IF (appmsg.numargs>0) AND (multi=0)
  71.                       quit:=0
  72.                   ENDIF
  73.                   IF (quit<>0) AND (multi=0)
  74.                       IF StrCmp(commande,'',ALL)=-1
  75.                           com:=FindToolType(struc_diskobj.tooltypes,'COM')
  76.                       ELSE
  77.                           com:=commande
  78.                       ENDIF
  79.                       Execute(com,0,stdout)
  80.                   ENDIF
  81.                   IF (multi=-1) AND (quit<>2)
  82.                       IF quit<>0
  83.                           IF StrCmp(commande,'',ALL)=-1
  84.                               com:=FindToolType(struc_diskobj.tooltypes,'COM')
  85.                           ELSE
  86.                               com:=commande
  87.                           ENDIF
  88.                           wb_args:=appmsg.arglist
  89.                           FOR x:=0 TO appmsg.numargs-1
  90.                               f_lock:=CurrentDir(wb_args[x].lock)
  91.                               StrCopy(final_com,com,ALL)
  92.                               StrAdd(final_com,' ',ALL)
  93.                               StrAdd(final_com,wb_args[x].name,ALL)
  94.                               Execute(final_com,NIL,stdout)
  95.                           ENDFOR
  96.                           f_lock:=CurrentDir(base_lock)
  97.                       ENDIF
  98.                   ENDIF
  99.                   ReplyMsg(appmsg)
  100.               ENDIF
  101.               IF de_passage=-1 THEN quit:=0
  102.           UNTIL quit=0
  103.           RemoveAppIcon(appicon)
  104.           DeleteMsgPort(myport)
  105.       ENDIF
  106.   ELSE
  107.     WriteF('Erreur structure diskobject.\n')
  108.   ENDIF
  109.   Raise(ER_NONE)
  110. EXCEPT
  111.   IF rdargs THEN FreeArgs(rdargs)
  112.   IF utilitybase THEN CloseLibrary(utilitybase)
  113.   IF iconbase THEN CloseLibrary(iconbase)
  114.   IF workbenchbase THEN CloseLibrary(workbenchbase)
  115.   IF struc_diskobj THEN FreeDiskObject(struc_diskobj)
  116.   IF intuitionbase THEN CloseLibrary(intuitionbase)
  117.   IF reqtoolsbase THEN CloseLibrary(reqtoolsbase)
  118.   IF sig THEN FreeSignal(sig)
  119.   SELECT exception
  120.     CASE ER_BADARGS;            info()
  121.     CASE ER_MEM;                WriteF('No mem!\n')
  122.     CASE ER_UTILLIB;            WriteF('Could not open "utility.library" v37\n')
  123.     CASE ER_ICONLIB;            WriteF('Could not open "icon.library" v37\n')
  124.     CASE ER_WBLIB;              WriteF('Could not open "workbench.library" v37\n')
  125.     CASE ER_INTUILIB;           WriteF('Could not open "intuition.library" v37\n')
  126.     CASE ER_EXECLIB;            WriteF('Could not open "exec.library" v37\n')
  127.     CASE ER_REQTOOLSLIB;        WriteF('Could not open "reqtools.library" v37\n')
  128.     CASE ER_APPIC;              WriteF('could not create AppIcon\n')
  129.     CASE ERROR_BREAK;           WriteF('\n*** BreakC ***\n')
  130.     CASE ERROR_BUFFER_OVERFLOW; WriteF('Internal error\n')
  131.     DEFAULT;                    PrintFault(exception,'Dos Error')
  132.   ENDSELECT
  133. ENDPROC
  134. PROC info() /*"Info()"*/
  135.     WriteF('\n')
  136.     WriteF('\e[32mMAppIc v0.0b \e[;31m(c) \e[;33m1993 \e[;32mNas\e[;33mG\e[0mûl.\n')
  137.     WriteF('Déscription :\n')
  138.     WriteF('\n')
  139.     WriteF(' <ICON>     - Nom del\aicône sans l\aextension .info .\n')
  140.     WriteF(' COM <nom>  - Nom de la commande.Si il y a plusieurs\n')
  141.     WriteF('              paramètres il faut utilisé des " ".\n')
  142.     WriteF(' NAME <nom> - Nom de l\aicône sur le WorkBench.\n')
  143.     WriteF(' QUIT       - Lance la commande une seul fois.\n')
  144.     WriteF(' TEST       - Permet de tester les coordonnées en x\n')
  145.     WriteF('              et en y d\aune icône.\e[;0m\n')
  146.     WriteF(' MULTI      - L\aicône se comporte comme une véritable\n')
  147.     WriteF('              AppIcon,c\aest à dire vous pouvez Shift-\n')
  148.     WriteF('              cliquez sur les fichiers, puis déplacer\n')
  149.     WriteF('              ceux-ci sur vôtre icône.Cette option est\n')
  150.     WriteF('              incompatible avec l\aoption quit.\n')
  151.     WriteF('\n')
  152.     WriteF('Pour quitter MAppIc il suffit de déplacer une\n')
  153.     WriteF('icône sur l\aicône de MAppIc.Sauf en mode multi (requester).\n')
  154. ENDPROC
  155.  
  156.